(* Creme Caramel Compiler (Triple C) - Michele Caceffo - 2008 *)
(*	Revision - Nataliia Bielova - 	2011		      *)

open Syntaxtree;;
open Exceptions;;
open Intermediate;;

(** Here are all the functions used to generate the declaration table *)

(* LDL: provide this new function to withdraw the user type definition from the given tdtable *)
(** Find the binded value corresponding to the ide into the Hashtable (where ide is the identifier for a user defined type)
    @param Ide(id) The ide to search into the table
    @param tdtable The type definition table
    @return The value binded with Ide(id) into tdtable
    @raise NON_DECLARED_TYPE When the requested ide isn't binded into the table
*)
let getTypeDeclaration (Ide(id): ide) (tdtable: typedef_table) = 
        try (
             Hashtbl.find tdtable (Ide(id))
        ) with Not_found -> raise (NON_DECLARED_TYPE ("ERROR: Undeclared type: "^ id))

(* LDL: create the functions to allow user type variables to be generated on the stack *)

(* LDL: this function allows to generate variables on stack of type rec_name.
        To do that it is drawn the record tree from the type declaration table,
         the one corresponding to rec_name. Then are distinguished two cases:
         if the tree is a Leaf then it holds a basic type different from a record
         and it is allocated on the stack the corresponsing cell, else if it is
         a Node instead, then the same function is recursively applied on all the
         children of the node.
*)
let rec genRecType (id: ide) (rec_name: ide) (table: dec_table) (tdtable: typedef_table) (ic: intermediateCode) (b: bool) =
  let rec genRecTypeInternal id (rtree: rec_tree) table tdtable ic b =
    (
      match rtree with
	  Leaf(_, bt) -> (genBtype id 1 1 bt table tdtable ic b)
	| (Node(_, rtl, _)) -> let auxfun = fun rt -> (genRecTypeInternal id rt table tdtable ic b) in
			       (* LDL: for how the hashtbl module works, we have to put them in reverse order *)
			       List.iter auxfun (List.rev rtl)
    )
  in 
  (* LDL: first of all we generate the entry for the record inside the declaration table.
          Note that the offset element is not pushed onto the stack, it is only a marker
          inside the declaration table.
          The corresponding dummy offset is set to the top of the stack: the current stack pointer + 1.
          It will also correspond to the offset of the first pushed variable.
  *)
  let dummy_offset = ic#getCurrentStack + 1 in
  let record_marker = (1, 1, (Off(dummy_offset, DRecord(rec_name), b))) in
  let TableRecord(rtree) = getTypeDeclaration rec_name tdtable in
  genRecTypeInternal id rtree table tdtable ic b;
  (* LDL: we put the following command as the last action (instead of issuing it before)
          in order to assure us to get it first when we will call the 'Hashtbl.find' function
  *)
  Hashtbl.add table id record_marker


and genUsrType (id: ide) (ut: usrType) (table: dec_table) (tdtable: typedef_table) (ic: intermediateCode) (b: bool) = match ut with
    UsrRecord(Record([rec_name])) -> (genRecType id rec_name table tdtable ic b)
  | UsrRecord(Record(_)) -> let msg = "This happens when a list is tried to be declared as a single user defined record type variable." ^
			      "This point is unreachable by parser structure."
			    in raise (CONFIRM_RULE msg)  

(* LDL: --------------------------------------------------------------------- *)

(* LDL: make the following function side-effect on the table to get everything smoother *)
(** Used to create a single variable entry on the dec_table
    @param idx The index of the variable (1 for single variables, the vector index for Vector or Matrix)
    @param dim The dimension of a line (1 for single variable, the number of columns for Vector or Matrix)
    @param bt The Basic type of the variable (int or float)
    @param ic The instance of the IntermediateCode class
    @param b True if the variable is declared into a subroutine, false if it's created globally
    @return The entry which is binded into the Hashtable
*)
(* LDL: allow user type variables to be generated on the stack also *)
and genBtype (id: ide) (idx: int) (dim: int) (bt: bType) (table: dec_table)
    (tdtable: typedef_table) (ic: intermediateCode) (b: bool) =
  match bt with
      Int     ->  let off = (ic#stack) in Hashtbl.add table id (idx, dim, (Off(off, DInt, b)))
    | Float   ->  let off = (ic#stack) in Hashtbl.add table id (idx, dim, (Off(off, DFloat, b)))
    | UsrType(ut) -> (genUsrType id ut table tdtable ic b)

(** Used to build the correct number of entries into the Declaration Hashtable 
    @param id The ide of the variable, which is used as key for the table
    @param t The generic Type of the variable
    @param table The declaration Table
    @param ic The instance of the IntermediateCode class
    @param b True if the variable is declared into a subroutine, false if it's created globally
*)
let genGtype (id: ide) (t: gType) (table: dec_table) (tdtable: typedef_table) (ic: intermediateCode) (b: bool): unit = match t with
        Basic(bt)       ->  (genBtype id 1 1 bt table tdtable ic b)
      | Pointer(pt)     ->  (* LDL: for a pointer variable we only add a single entry to the table,
			             whatever it is the pointed type. However, we shall care
			             about what the pointed type is even then, what it evaluates to,
			             since static semantics makes use of this information.
			            Pointers are initialized to -1 to indicate that they have not
			             been referenced to any variable yet (to avoid invalid dereferencing
			             issues).
			    *)
 	                    let entry_value =
	                      let off = (ic#stack) and stype = getSemanticGtype (Pointer(pt)) table tdtable in
			      (* LDL: define the position of the new variable *)
			      let off_element = (Off(off, stype, b)) in
			      (* LDL: initialize the pointer variable to NULL *)
			      ic#addInstr(SETNULL, Null, Null, off_element);
			      (1, 1, off_element)
			    in
			    Hashtbl.add table id entry_value
      | Vector(x,bt)    ->  (*  First of all we create a list with all the entries of the table that correspond to the vector,	
				then we add it to the table. In this way we allocate single elements of the vector in a correct 
				order in the stack (by pushing the elements in a reversed order). The insertion in the table is made 
				in such a way that Hashtbl.find_all returns as a resul the first element with index 0 of the vector 
				(see the documentation of the functions for the hash table, that are in the Hashtbl module)
			    *)
                            for index=(x-1) downto 0 do genBtype id index x bt table tdtable ic b done
      | Matrix(x,y,bt)  ->  for index=(x*y-1) downto 0 do genBtype id index x bt table tdtable ic b done
                            (** This works only with bi-dimensional Matrix, not with n-dimensional Vectors *)

(* LDL: generate a new function that allows to build up the table that associates type identifiers to types *)
(** Generate the table of type definitions from the type_def list
    @param typel The type definition list
    @param tdtable The declaration Hashtable
    @param ic The instance of the IntermediateCode class
    @return The updated table of type definitions
*)
let genTypeDefTable (typel: type_def list) (tdtable: typedef_table) : typedef_table = 
  let rec genTypeDefTable_aux typel tdtable = 
    match typel with
        []       ->  tdtable
      | TypeDef(id, t) :: xs  ->  
	let entry_value = 
	  let children_list = match t with
	    TRecord(trec_field_list) -> 
	      let rec rtree_of_fieldlist fl = match fl with
		  [] -> []
		| TRecordField(ide, bt) :: xs -> let child_node =
						   (
						     match bt with
							 UsrType(ut) ->
							   (
							     match ut with
								 UsrRecord(Record([subrecord_ide])) -> 
								   let TableRecord(node) = getTypeDeclaration subrecord_ide tdtable in
								   (
								     match node with
									 Node(_, rtl, type_ide) -> Node(ide, rtl, type_ide)
								       | Leaf(_, btype) -> Leaf(ide, btype)
								   )
							       | UsrRecord(Record(_)) -> let msg = "This only happens when " ^
											   "a list is tried to be declared as " ^
											   "a single user defined record type variable." ^
											   "This point is unreachable by parser structure."
											 in raise (CONFIRM_RULE msg)  
							   )
						       | _ -> Leaf(ide, bt)
		                                   )
						 in
						 child_node :: (rtree_of_fieldlist xs)
	      in
	      (rtree_of_fieldlist trec_field_list)
	  in
	  Node(id, children_list, id)
	in
	Hashtbl.add tdtable id (TableRecord(entry_value)); genTypeDefTable_aux xs tdtable
  in genTypeDefTable_aux typel tdtable

(** Generate the table of declarations from the dec list
    @param decl The declaration list
    @param table The declaration Hashtable
    @param ic The instance of the IntermediateCode class
    @param b True if the variable is declared into a subroutine, false if it's created globally
    @return The updated table of declaration
*)
let rec genDecTable (decl: dec list) (table: dec_table) (tdtable: typedef_table) (ic: intermediateCode) (b: bool) : dec_table = 
    match decl with
        []              ->  table
      | (Dec(id,t))::xs ->  (genGtype id t table tdtable ic b); genDecTable xs table tdtable ic b

(** Find the binded value corresponding to the ide into the Hashtable (where ide is the identifier for a variable, NOT Vectors or Matrix)
    @param Ide(id) The ide to search into the table
    @param table The declaration table
    @return The value binded with Ide(id) into table
    @raise NON_DECLARED_VARIABLE When the requested ide isn't binded into the table
*)
(* LDL: this function has been modified (actually renamed and added another) in order to accomodate the use of pointers.
        The first value returned for a pointer variable would be the marker for the pointer variable.
        Sometimes we want the actual type and value for a cell, so we use this function.
*)
let getVarDeclaration (Ide(id): ide) (table: dec_table) = 
        try (
	  let matching_vals = Hashtbl.find_all table (Ide(id)) in
	  let is_DRecord entry =
	    (
	      match entry with
		  _, _, Off(_, DRecord(_), _) -> true
		| _ -> false
	    )
	  in
	  if (List.length matching_vals) > 1 && is_DRecord (List.hd matching_vals) then
            List.nth (matching_vals) ((List.length matching_vals) - 1)
	    else List.nth (matching_vals) 0
        ) with Not_found -> raise (NON_DECLARED_VARIABLE ("ERROR: Undeclared variable: "^ id))

(** Find the binded value corresponding to the ide into the Hashtable (where ide is the identifier for a variable, NOT Vectors or Matrix)
    @param Ide(id) The ide to search into the table
    @param table The declaration table
    @return The value binded with Ide(id) into table
    @raise NON_DECLARED_VARIABLE When the requested ide isn't binded into the table
*)
(* LDL: this function has been created (actually this is the renamed one) in order to accomodate the use of pointers.
        The first value returned for a pointer variable is the marker for the pointer variable,
        that is what we are interested in when dealing with static semantics.
        Sometimes we want the actual type and value for a cell, so we use getVarDeclaration better.
*)
let getVarDeclaration4Semantics (Ide(id): ide) (table: dec_table) = 
        try (
	  Hashtbl.find table (Ide(id))
        ) with Not_found -> raise (NON_DECLARED_VARIABLE ("ERROR: Undeclared variable: "^ id))

(** Find the binded value corresponding to the ide into the Hashtable (where ide is the identifier for Vectors or Matrix)
    @param Ide(id) The ide to search into the table
    @param x The X coordinate of the Vector/Matrix
    @param y The Y coordinate of the Matrix (-1 if the ide refers to a Vector, which has only one component)
    @param table The declaration table
    @return The value binded with Ide(id) with the specified components into table
    @raise NON_DECLARED_VARIABLE When the requested ide isn't binded into the table
*)
let getVecDeclaration (Ide(id): ide) (x: int) (y: int) (table: dec_table) = 
        try (
             let elList = Hashtbl.find_all table (Ide(id)) in
             if (y = -1) then
                List.nth elList x
             else (
                let (_, dim, _) = List.nth elList 0 in 
                    List.nth elList ((x*dim) + y)
             )
        ) with Not_found -> raise (NON_DECLARED_VARIABLE ("ERROR: Undeclared variable: "^ id))

(** Check if the variable is binded into the Hashtable
    @param id The ide of the variable to check
    @param table The declaration Table
    @return True of the variable is binded, False otherwise
*)
let isVarDeclared (id: ide) (table: dec_table): bool = Hashtbl.mem table id
